! Project TWS Matrixexponentiële
!
!
! PROGRAM TEST
!
! Dit programma bevat uitgebreide testen voor de modules IO, fftw en methods.
!
!
! @author Roel Matthysen
! @version 2.0
program test

use methods
use IO
use auxtest
use time
implicit none
! PARAMETERS
integer, parameter :: doubleprecision = kind(0.d0)
integer, parameter :: numberoftests = 10;
real(doubleprecision), parameter :: tol = 10.0d0**(-7)
logical :: verbose = .false.

! Variabelen
integer i,n
logical :: circulant
real(doubleprecision),allocatable :: A(:,:),B(:,:),C(:,:)
real(doubleprecision),allocatable :: Ac(:), Bc(:), Cc(:)
real(doubleprecision), allocatable :: err(:,:),ms(:,:)
integer, allocatable :: sizes(:)
logical, allocatable :: succes(:,:)
character, allocatable :: typematrix(:)
CHARACTER(len = 28) :: fnamein
CHARACTER(len = 29) :: fnameout

! Test Programma
print *, '   __  __       _        _       ________   _______  '
print *, '  |  \/  |     | |      (_)     |  ____\ \ / /  __ \ '
print *, '  | \  / | __ _| |_ _ __ ___  __| |__   \ V /| |__) |'
print *, '  | |\/| |/ _` | __| "__| \ \/ /|  __|   > < |  ___/ '
print *, '  | |  | | (_| | |_| |  | |>  < | |____ / . \| |  '   
print *, '  |_|  |_|\__,_|\__|_|  |_/_/\_\|______/_/ \_\_| '    
print *, '                   '                                
print *, '   _            _   '
print *, '  | |          | |  '
print *, '  | |_  ___ ___| |_ '
print *, '  | __|/ _ | __| __|'
print *, '  | |_|  __|__ \ |_ '
print *, '   \__|\___|___/\__|'      
print *, ' '             
! Testen of de Help wel werkt
print *, '############################'
print *, '#### TEST HELPBOODSCHAP ####'
print *, '############################'
call displayhelp()
print *, ' '
! Testen voor de IO
print *, '############################'
print *, '#### TEST INVOER/UITVOER ###'
print *, '############################'
call iotest()
print *, ' '
! Testen voor de Fourier-transform
print *, '############################'
print *, '#### TEST FFT ##############'
print *, '############################'
print *, ' '
print *, '                 fft      ifft    '
print *, '-------------------------------'
call ffttest(1)
call ffttest(2)
call ffttest(3)
call ffttest(4)
print *, ' '
print *, '############################'
print *, '#### TEST METHODES #########'
print *, '############################'
print *, ' '
print *, ' De verschillende methodes zijn getest voor verschillende groottes en types van matrices.'
print *, ' De resultaten zijn samengevat in een tabel:'
print *, ' -Voor de relatieve fouten'
print *, ' -Voor de timings van elke methode'
print *, ' -Of de relatieve fout al dan niet onder de tolerantie zit'
print *, ' '
print *, ' Elementen uit de tabel:'
print *, ' '
print *, ' Type:'
print *, '       -Circulant'
print *, '       -Vol'
print *, ' '
print *, ' N: grootte van de matrix (alle matrices zijn vierkant en NxN)'
print *, ' '
print *, ' '
allocate(err(numberoftests,3))
allocate(ms(numberoftests,3))
allocate(typematrix(numberoftests))
allocate(succes(numberoftests,3))
allocate(sizes(numberoftests))
typematrix(1:5)='V'
typematrix(6:10)='C'
! Berekenen van de fouten
do i = 1,numberoftests
    ! Input en output regelen
    WRITE(fnamein,'(a,i2,a)')'testmatrices/testmatrix', i+10, '.in'
    OPEN(32,file=fnamein)
    WRITE(fnameout,'(a,i2,a)') 'testmatrices/testmatrix', i+10, '.out'
    OPEN(33,file=fnameout)
    call iscirculant(32, circulant, n);
    sizes(i)=n;
    if(circulant) then
        ! data alloceren
        allocate(Ac(n))
        allocate(Bc(n))
        allocate(Cc(n))
        Ac = readmatrixc(n,32)     
        Bc = readmatrixc(n,33, .true.)
        ! Berekeningen uitvoeren en timen
        call processor_tic()
        Cc = taylorexpc(Ac,verbose)
        ms(i,1)=processor_toc()
        err(i,1)=comparec(Cc,Bc)
        succes(i,1)=(err(i,1)<tol)
        call processor_tic()
        Cc = eigc(Ac,verbose)
        ms(i,2)=processor_toc()
        err(i,2)=comparec(Cc,Bc)
        succes(i,2)=(err(i,2)<tol)
        call processor_tic()
        Cc = eigqrc(Ac,verbose)
        ms(i,3)=processor_toc()
        err(i,3)=comparec(Cc,Bc)
        succes(i,3)=(err(i,3)<tol)
        deallocate(Ac)
        deallocate(Bc)
        deallocate(Cc)
    else
        ! Data alloceren
        allocate(A(n,n))
        allocate(B(n,n))
        allocate(C(n,n))
        A = readmatrix(n,32)
        B = readmatrix(n,33, .true.)
        ! Berekeningen uitvoeren en timen 
        call processor_tic()
        C = taylorexp(A,verbose)
        ms(i,1)=processor_toc()
        err(i,1)=compare(C,B)
        succes(i,1)=(err(i,1)<tol)
        call processor_tic()
        C = eig(A,verbose)
        ms(i,2)=processor_toc()
        err(i,2)=compare(C,B)
        succes(i,2)=(err(i,2)<tol)
        call processor_tic()
        C = eigqr(A,verbose)
        ms(i,3)=processor_toc()
        err(i,3)=compare(C,B)
        succes(i,3)=(err(i,3)<tol)
        deallocate(A)
        deallocate(B)
        deallocate(C)
    endif
    close(32)
    close(33)
enddo
! Printing of the results
print *, ' '
print *, '#### TOLERANCE ###############'
print *, ' '
write(6,'(a27,a14,2x,a14,2x,a14)') '             Type   N      ','taylor        ','eig           ','eigqr         '
print *, '------------------------------------------------------------'
do i=1,numberoftests
        write(6, '(a4,3x,i2,4x,a1,3x,i4)',ADVANCE="NO") 'Test',i,typematrix(i),sizes(i)
        write(6,'(6x,a8,8x,a8,8x,a8)') pstat(succes(i,1)),pstat(succes(i,2)),pstat(succes(i,3))
enddo
print *, ' '
print *, '#### RELATIEVE FOUT ##########'
print *, ' '
write(6,'(a27,a14,2x,a14,2x,a14)') '             Type   N      ','taylor        ','eig           ','eigqr         '
print *, '------------------------------------------------------------'
do i=1,numberoftests
        write(6, '(a4,3x,i2,4x,a1,3x,i4,3x,es14.7,2x,es14.7,2x,es14.7)') 'Test', i,typematrix(i),sizes(i),err(i,1),err(i,2),err(i,3)
enddo
print *, ' '
print *, '#### TIMINGS ################'
print *, ' '
write(6,'(a27,a14,2x,a14,2x,a14)') '             Type   N      ','taylor        ','eig           ','eigqr         '
print *, '------------------------------------------------------------'
do i=1,numberoftests
        write(6, '(a4,3x,i2,4x,a1,3x,i4,3x,f14.7,2x,f14.7,2x,f14.7)') 'Test', i, typematrix(i), sizes(i), ms(i,1), ms(i,2), ms(i,3)
enddo

! Deallocation

deallocate(err)
deallocate(sizes)
deallocate(succes)
deallocate(ms)
deallocate(typematrix)
    
contains

! Compare two matrices
function compare(A,B) result(error)
real(doubleprecision) :: error
real(doubleprecision) :: A(:,:),B(:,:)
error = maxval(abs(A-B)/A)
end function

! Compare two vectors
function comparec(A,B) result(error)
real(doubleprecision) :: error
real(doubleprecision) :: A(:),B(:)
error = maxval(abs(A-B)/A)
end function

end program
